Данные

На этой странице:
сбор и предобработка данных. Код и комментарии к нему.

---

Сбор данных

1. Загружаем все необходимые для нашего исследования библиотеки.

library(tidyverse)
library(rvest)
library(tidytext)
library(tokenizers)
library(udpipe)
library(dplyr)
library(ggplot2)
library(readr)

2. Список переводов писем Розы Люксембург размещен на 4 веб-страницах, по 50 url на каждой. Соберем все 184 ссылки.

# первая страница с ссылками (0-50)
url1 <- "https://proza.ru/avtor/cnamibog&s=0&book=45#45" 
html1 <-  read_html(url1, encoding = "Windows-1251") # читаем html, меняем кодировку

#.poemlink - список ссылок на нужные страницы, собранный с помощью SelectorGadget

list_links1 <- html1 |> 
  html_elements(".poemlink") # загружаем список ссылок


# вторая страница с ссылками (51-100)
url2 <- "https://proza.ru/avtor/cnamibog&s=50&book=45#45" 
html2 <-  read_html(url2, encoding = "Windows-1251") # читаем html, меняем кодировку

#.poemlink - список ссылок на нужные страницы, собранный с помощью SelectorGadget

list_links2 <- html2 |> 
  html_elements(".poemlink") # загружаем список ссылок


# третья страница с ссылками (101-150)
url3 <- "https://proza.ru/avtor/cnamibog&s=100&book=45#45" 
html3 <-  read_html(url3, encoding = "Windows-1251") # читаем html, меняем кодировку

#.poemlink - список ссылок на нужные страницы, собранный с помощью SelectorGadget

list_links3 <- html3 |> 
  html_elements(".poemlink") # загружаем список ссылок


# четвертая страница с ссылками (151-184)
url4 <- "https://proza.ru/avtor/cnamibog&s=150&book=45#45" 
html4 <-  read_html(url4, encoding = "Windows-1251") # читаем html, меняем кодировку

#.poemlink - список ссылок на нужные страницы, собранный с помощью SelectorGadget

list_links4 <- html4 |> 
  html_elements(".poemlink") # загружаем список ссылок

3. Создадим таблицу с URL-ссылками на все 184 текста.

# Объединяем списки в один, частичный URL
all_links <- list(list_links1, list_links2, list_links3, list_links4) |> 
  map_dfr(~ tibble(
    title = .x |> html_text2(),
    id_text = .x |> html_attr("href")
  ))

# Выводим объединённую таблицу
print(all_links)

# A tibble: 184 × 2
   title                     id_text         
   <chr>                     <chr>           
 1 Другая Роза               /2014/04/05/1003
 2 второе письмо             /2015/04/18/686 
 3 Только Дело               /2014/05/01/568 
 4 Ежовые рукавицы           /2014/04/29/1795
 5 Как сердцу высказать себя /2014/05/02/722 
 6 синяки на душе            /2014/05/04/741 
 7 вторым классом            /2015/04/22/694 
 8 удачная поездка           /2015/04/23/918 
 9 середина лета 1898 года   /2015/04/25/1336
10 неловкие попытки          /2015/04/27/493 
# ℹ 174 more rows

# Добавляем (paste0 += без пробела) протокол доступа и доменное имя. 
# Получаем полные URL-адреса страниц с главами повести.
all_links <- all_links |>
  mutate(link = paste0("https://proza.ru", id_text)) 
# select(-id_text) не делаю, id записи = дате публикации

# Извлекаем список всех ссылок
all_roza_urls <- all_links |> 
  pull(link)

# print(all_roza_urls)

4. Скрапинг текста

# Напишем функцию для скрапинга текста
get_text <- function(url){
  read_html(url, encoding = "Windows-1251") |> 
    html_elements(".text") |> 
    html_text2() |> 
    paste(collapse=" ")
}

# Применим функцию к полному списку извлеченных ссылок. 
# Получаем Large list.
raw_all_roza_texts <- map(all_roza_urls, get_text)

# Превращаем список в символьный вектор, а его в таблицу
raw_roza_texts_tbl <- raw_all_roza_texts |> 
  flatten_chr() |> 
  as_tibble()

# Объединяем две таблицы (ссылки, названия текстов и сами тексты)
all_roza_proza <- all_links |> 
  mutate(text = raw_roza_texts_tbl)

Предобработка данных

Чистим данные с помощью регулярных выражений.

# Переименовываем столбец
# Удаляем HTML-теги
# Унифицируем кавычки, апострофы
# Убираем лишние переводы строки (включая пробелы вокруг них), заменяем их на пробел
# Убираем звездочки перед словами (от примечаний)
# Ставим перед записанными с ошибками именами МАРКЕР
all_roza_cleaned <- all_roza_proza |>
  mutate(text = text$value) |> 
  mutate(text = str_remove_all(as.character(text), "<[^>]+>")) |>
  mutate(text = str_replace_all(text, "[«»„”‘’]", "\"")) |> 
  mutate(text = gsub("\\s*\\n+\\s*", " ", text)) |> 
  mutate(text = gsub("\\b([Нн]и{1,2}у\\S*)", "NIU_\\1", text)) |> 
  mutate(text = gsub("\\b([Кк]ост\\S*)", "KOSTYA_\\1", text)) |> 
  mutate(text = gsub("\\b([Юю]{2}\\S*)", "YuYu_\\1", text)) |>
  mutate(text = gsub("^[*]+", "", text)) |> 
  mutate(text = str_replace_all(text, "\\b([Рр]оз(?!енфельд|енталь)(\\S*))", "ROZA_\\1")) |> 
  mutate(text = gsub("\\b([Мм]ими)", "MIMI_\\1", text)) |> 
  mutate(text = gsub("\\b([Дд][Цц]ио|[Цц]иу|[Дд]иу)\\S*", "DZIO_\\1", text)) |> 
  mutate(text = gsub("\\b([Шш]ое|[Шш]оэ|[Шш]\\.)\\S*", "Schönlank_\\1", text)) |> 
  mutate(text = gsub("\\b([Мм]атиль\\S*)", "MATILDA_\\1", text)) |> 
  mutate(text = gsub("\\b([Лл]улу)", "LULU_\\1", text))

Аннотирование текста

Скачиваем и загружаем модель. Аннотируем.

# Создаем папку models, если её ещё нет
if (!dir.exists("models")) {
  dir.create("models")
}

# Добавляем models/ в .gitignore, если её там нет
if (!file.exists(".gitignore")) {
  write("models/", file = ".gitignore")
} else {
  # Читаем содержимое .gitignore
  gitignore_content <- readLines(".gitignore")
  
  # Проверяем, есть ли уже models/
  if (!"models/" %in% gitignore_content) {
    # Добавляем строку в конец файла, если её нет
    write("models/", file = ".gitignore", append = TRUE)
  }
}

# Указываем путь к модели
model_path <- "models/russian-syntagrus-ud-2.5-191206.udpipe"

# Проверяем, существует ли файл модели
if (!file.exists(model_path)) {
  message("Скачиваем модель...")
  udpipe_download_model(language = "russian-syntagrus", model_dir = "models")
} else {
  message("Модель уже скачана.")
}

# Загружаем модель
russian_syntagrus <- udpipe_load_model(file = model_path)

# Отобразим текст в документе Quarto
cat("Модель успешно загружена и готова к использованию.")

Модель успешно загружена и готова к использованию.

# Скачиваем модель в рабочую директорию
##| echo: false
# udpipe_download_model(language = "russian-syntagrus")

# загружаем модель
##| echo: false
#russian_syntagrus <- udpipe_load_model(file = "russian-syntagrus-ud-2.5-191206.udpipe")

# Оператор присваивания создает переменную params.
params <- tribble(
  ~tbl, ~output, ~input, ~token,
  all_roza_cleaned, "word", "text", "words"
)

params

# аннотируем
##| echo: false
all_roza_annotate <- udpipe_annotate(
  russian_syntagrus, 
  all_roza_cleaned$text, 
  doc_id = all_roza_proza$title)

# преобразуем аннотированное в тибл
##| echo: false
all_roza_ann_tbl <- as_tibble(all_roza_annotate) |> 
  select(-paragraph_id, -sentence, -xpos) |> 
  as_tibble()

Токенизация

1. Токенизируем.

all_roza_tokens <- all_roza_cleaned |> 
  unnest_tokens("word",
                "text",
                to_lower = TRUE,
                strip_punct = TRUE) |> 
  select(-id_text)

all_roza_tokens

2. Создаем списки стоп-слов

# Загружаем список список стоп-слов ('nltk')
library(stopwords)
stopwords("ru")

  [1] "и"       "в"       "во"      "не"      "что"     "он"      "на"     
  [8] "я"       "с"       "со"      "как"     "а"       "то"      "все"    
 [15] "она"     "так"     "его"     "но"      "да"      "ты"      "к"      
 [22] "у"       "же"      "вы"      "за"      "бы"      "по"      "только" 
 [29] "ее"      "мне"     "было"    "вот"     "от"      "меня"    "еще"    
 [36] "нет"     "о"       "из"      "ему"     "теперь"  "когда"   "даже"   
 [43] "ну"      "вдруг"   "ли"      "если"    "уже"     "или"     "ни"     
 [50] "быть"    "был"     "него"    "до"      "вас"     "нибудь"  "опять"  
 [57] "уж"      "вам"     "сказал"  "ведь"    "там"     "потом"   "себя"   
 [64] "ничего"  "ей"      "может"   "они"     "тут"     "где"     "есть"   
 [71] "надо"    "ней"     "для"     "мы"      "тебя"    "их"      "чем"    
 [78] "была"    "сам"     "чтоб"    "без"     "будто"   "человек" "чего"   
 [85] "раз"     "тоже"    "себе"    "под"     "жизнь"   "будет"   "ж"      
 [92] "тогда"   "кто"     "этот"    "говорил" "того"    "потому"  "этого"  
 [99] "какой"   "совсем"  "ним"     "здесь"   "этом"    "один"    "почти"  
[106] "мой"     "тем"     "чтобы"   "нее"     "кажется" "сейчас"  "были"   
[113] "куда"    "зачем"   "сказать" "всех"    "никогда" "сегодня" "можно"  
[120] "при"     "наконец" "два"     "об"      "другой"  "хоть"    "после"  
[127] "над"     "больше"  "тот"     "через"   "эти"     "нас"     "про"    
[134] "всего"   "них"     "какая"   "много"   "разве"   "сказала" "три"    
[141] "эту"     "моя"     "впрочем" "хорошо"  "свою"    "этой"    "перед"  
[148] "иногда"  "лучше"   "чуть"    "том"     "нельзя"  "такой"   "им"     
[155] "более"   "всегда"  "конечно" "всю"     "между"  

stopwords_ru <- c(stopwords("ru", source = "nltk"))

# Убираем повторы и упорядочиваем по алфавиту
stopwords_ru <- sort(unique(stopwords_ru))
stopwords_ru

  [1] "а"       "без"     "более"   "больше"  "будет"   "будто"   "бы"     
  [8] "был"     "была"    "были"    "было"    "быть"    "в"       "вам"    
 [15] "вас"     "вдруг"   "ведь"    "во"      "вот"     "впрочем" "все"    
 [22] "всегда"  "всего"   "всех"    "всю"     "вы"      "где"     "да"     
 [29] "даже"    "два"     "для"     "до"      "другой"  "его"     "ее"     
 [36] "ей"      "ему"     "если"    "есть"    "еще"     "ж"       "же"     
 [43] "за"      "зачем"   "здесь"   "и"       "из"      "или"     "им"     
 [50] "иногда"  "их"      "к"       "как"     "какая"   "какой"   "когда"  
 [57] "конечно" "кто"     "куда"    "ли"      "лучше"   "между"   "меня"   
 [64] "мне"     "много"   "может"   "можно"   "мой"     "моя"     "мы"     
 [71] "на"      "над"     "надо"    "наконец" "нас"     "не"      "него"   
 [78] "нее"     "ней"     "нельзя"  "нет"     "ни"      "нибудь"  "никогда"
 [85] "ним"     "них"     "ничего"  "но"      "ну"      "о"       "об"     
 [92] "один"    "он"      "она"     "они"     "опять"   "от"      "перед"  
 [99] "по"      "под"     "после"   "потом"   "потому"  "почти"   "при"    
[106] "про"     "раз"     "разве"   "с"       "сам"     "свою"    "себе"   
[113] "себя"    "сейчас"  "со"      "совсем"  "так"     "такой"   "там"    
[120] "тебя"    "тем"     "теперь"  "то"      "тогда"   "того"    "тоже"   
[127] "только"  "том"     "тот"     "три"     "тут"     "ты"      "у"      
[134] "уж"      "уже"     "хорошо"  "хоть"    "чего"    "чем"     "через"  
[141] "что"     "чтоб"    "чтобы"   "чуть"    "эти"     "этого"   "этой"   
[148] "этом"    "этот"    "эту"     "я"      

# Добавляем дополнительные стоп-слова
other <- c(" ", "", "это", "который", "роза", 
           "весь", "мочь", "свой", "твой", "очень", 
           "каждый", "ваш", "изза", "поэтому", 
           "хотя", "сразу", "наш", "все", "еще", "ее", "её", 
           "тебе", "твое", "кроме", "мои", "dieser", "in", 
           "der", "dir", "dein", "die", "den", "ich", "und",
           "всё", "ещё", "твоё", "моё", "неё", "которые", 
           "моей", "лишь", "своей", "моего", "которых", 
           "таких", "таким", "своими", "ними", "также", "мной", 
           "крайней", "мере", "конце", "концов", "которой", 
           "которое", "вообще", "свои", "которая", "например", 
           "такие", "этим", "такую", "эта", "каким", "которую", 
           "to")

3. Удаляем стоп-слова. Делаем две tidy таблицы

# Делаем tidy таблицу с лемматизированными данными: 
# Переименовываем колонку lemma
all_roza_ann_tbl <- all_roza_ann_tbl |> 
  mutate(word = lemma)

# Переводим колонку word в нижний регистр
# Удаляем все знаки препинания из столбца word
# Убираем все комбинации ".»", встречающиеся перед границей слова в столбце lemma
# Удаляем стоп слова + доп. стоп-слова
all_roza_tidy <- all_roza_ann_tbl |>
  mutate(word = tolower(str_trim(word))) |>
  mutate(word = gsub("[[:punct:]]", "", word)) |> 
  mutate(lemma = gsub("\\.»\\b", "", lemma)) |>
  anti_join(tibble(word = stopwords_ru)) |> 
  filter(!word %in% other)

all_roza_tidy

# Делаем tidy таблицу с токенизированными данными
# Необходимость в токенизированной таблице возникала из-за грязных исходных данных.
# Невычитанный текст с множеством опечаток и ошибок неверно лемматизировался.
rp_token_tidy <- all_roza_tokens |> 
  anti_join(tibble(word = stopwords_ru)) |> 
  filter(!word %in% other)

rp_token_tidy